home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
UTIL
/
Alpha 6.5.sit
/
Tcl
/
Modes
/
htmlElems.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
25KB
|
920 lines
#===============================================================================
#
# htmlElems.tcl (called by html.tcl)
#
# Part of HTML mode 1.2
#
# Macros for HTML elements.
#
# Author: Johan Linde <jl@theophys.kth.se>
#
# If you make improvements to this file, please share them!
#
#===============================================================================
#
# <P>
#
proc htmlElemParagraph {{attr ""}} {
global HTMLmodeVars
set pIsContainer $HTMLmodeVars(pIsContainer)
if ($pIsContainer) {
htmlBuildCR2Elem P $attr
} else {
htmlBuildOpening P 1 1 $attr
}
}
# Insert a <BR> in the end of every line in selection.
proc htmlInsertLineBreaks {} {
if {![isSelection]} {
beep
message "No selection."
return
}
foreach ln [split [string trimright [getSelect] "¥r"] "¥r"] {
append text "${ln}[htmlSetCase <BR>]¥r"
}
replaceText [getPos] [selEnd] $text
}
# Remove all <BR> in selection.
proc htmlRemoveLineBreaks {} {
if {![isSelection]} {
beep
message "No selection."
return
}
regsub -all "<(b|B)(r|R)(¥[ ¥t¥r¥]+¥[^>¥]*>|>)" [getSelect] "" text
if {$text != [getSelect]} {
replaceText [getPos] [selEnd] $text
}
}
# Insert <P> at empty lines in selection, and in the beginning of the selection.
# Several empty lines are contracted to one.
proc htmlInsertParagraphs {} {
global HTMLmodeVars
if {![isSelection]} {
beep
message "No selection."
return
}
set pIsContainer $HTMLmodeVars(pIsContainer)
set oelem [htmlOpenElem P]
if {![string length $oelem]} {return}
set text "¥r$oelem¥r"
set prevLineEmpty 1
foreach ln [split [string trim [getSelect] "¥r"] "¥r"] {
regexp {[ ¥t]*} $ln lntest
# Only add <P> if previous line was not empty.
if {$ln == $lntest && !$prevLineEmpty} {
set prevLineEmpty 1
if {$pIsContainer} {
append text "[htmlCloseElem P]¥r¥r$oelem¥r"
} else {
append text "¥r$oelem¥r"
}
} else {
# Skip an empty line which follows another empty line.
if {$ln != $lntest} {
set prevLineEmpty 0
append text "$ln¥r"
}
}
}
if {$pIsContainer} {
append text "[htmlCloseElem P]¥r¥r"
}
replaceText [getPos] [selEnd] $text
}
# Ask for input how to build a list. Returns "number of items" and
# "ask for list item attributes". Returns "" if canceled or any problem.
proc htmlListQuestions {ltype liattr lipr} {
global HTMLmodeVars
set promptNoisily $HTMLmodeVars(promptNoisily)
if {[string length $liattr]} {
set optatts [htmlGetOptional $liattr]
set usedatts [htmlGetUsed $liattr]
set askForMore [htmlGetAttrMore $liattr]
} else {
set optatts ""
set askForMore [htmlGetAttrMore LI]
set usedatts [htmlGetUsed LI]
}
if {$lipr != "LI"} {
set optatts [concat $optatts [htmlGetOptional DD]]
set usedatts [concat $usedatts [htmlGetUsed DD]]
if {!$askForMore} {set askForMore [htmlGetAttrMore DD]}
}
if {$HTMLmodeVars(useBigWindows)} {
set it {0 0 3 0}
while {1} {
set txt "dialog -w 280 -h 130 -b OK 20 100 75 120 -b Cancel 110 100 165 120 ¥
-t {$ltype list} 100 10 250 30 ¥
-t {How many items?} 10 40 150 60 -e [list [lindex $it 2]] 160 40 180 55"
if {[llength $optatts]} {
append txt " -c {Ask for attributes for each $lipr} [lindex $it 3] ¥
10 70 330 85"
}
set it [eval $txt]
if {[lindex $it 1]} {return}
set items [lindex $it 2]
if {[llength $it] == 4 && [lindex $it 3]} {
set askForLiAttr 1
} else {
set askForLiAttr 0
}
if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
alertnote "Invalid input: non-negative integer required"
} elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
alertnote "Invalid input: positive integer required"
} else {
break
}
}
} else {
if {$promptNoisily} {beep}
while {[catch {statusPrompt "$ltype list: How many items? " htmlNumberStatusFunc} items]} {
if {$items == "Cancel all!"} {message "Cancel"; return}
}
if {![htmlIsUnsignedInteger $items] && $ltype != "DL"} {
beep; message "Invalid input: non-negative integer required."; return
} elseif {![htmlIsPositiveInteger $items] && $ltype == "DL"} {
beep; message "Invalid input: positive integer required."; return
}
if {(([llength $optatts] && $askForMore) || [llength $usedatts]) && $items} {
if {$promptNoisily} {beep}
while {[catch {statusPrompt "Ask for attributes for each $lipr? ¥[n¥] " ¥
htmlStatusAskYesOrNo} v]} {
if {$v == "Cancel all!"} {message "Cancel"; return}
}
if {$v == "yes"} {
set askForLiAttr 1
} else {
set askForLiAttr 0
}
} else {
set askForLiAttr 0
}
}
return [list $items $askForLiAttr]
}
# Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
# insertion point there. If anything is selected, makes it the first item.
proc htmlBuildList {ltype {liattr ""} {listattr ""}} {
global HTMLmodeVars
global htmlCurSel
global htmlIsSel
set useTabMarks $HTMLmodeVars(useTabMarks)
set containers $HTMLmodeVars(lidtAreContainers)
set listStr [htmlListQuestions $ltype $liattr LI]
if {![llength $listStr]} {
return
} else {
set items [lindex $listStr 0]
set askForLiAttr [lindex $listStr 1]
}
# If zero list items, just make an htmlBuildCR2Elem
if {$items == 0} {
htmlBuildCR2Elem $ltype $listattr
return
}
htmlGetSel
set sel $htmlCurSel
set IsSel $htmlIsSel
set text [htmlOpenCR 1]
if {$containers} {
set text1 "[htmlOpenElem $ltype $listattr]¥r"
if {$text1 == "¥r"} {return}
append text $text1
if {$askForLiAttr} {
set text1 [htmlOpenElem LI $liattr]
} else {
set text1 [htmlOpenElem LI NOATTR]
}
if {$text1 == ""} {return}
append text $text1
if {$IsSel} {
append text "${sel}[htmlCloseElem LI]"
set currpos [expr [getPos] + [string length $text]]
} else {
set currpos [expr [getPos] + [string length $text]]
append text [htmlCloseElem LI]
}
for {set i 1} {$i < $items} {incr i} {
append text "¥r"
if {$askForLiAttr} {
set text1 [htmlOpenElem LI $liattr]
} else {
set text1 [htmlOpenElem LI NOATTR]
}
if {$text1 == ""} {return}
append text $text1
if {$i == 1 && $IsSel} {
set currpos [expr [getPos] + [string length $text]]
} elseif {$useTabMarks} {
append text "・"
}
append text [htmlCloseElem LI]
}
} else {
set text1 [htmlOpenElem $ltype $listattr]
if {$text1 == ""} {return}
append text $text1
append text "¥r"
if {$askForLiAttr} {
set text1 [htmlOpenElem LI $liattr]
} else {
set text1 [htmlOpenElem LI NOATTR]
}
if {$text1 == ""} {return}
append text $text1
if {$IsSel} {
append text $sel
}
set currpos [expr [getPos] + [string length $text]]
for {set i 1} {$i < $items} {incr i} {
append text "¥r"
if {$askForLiAttr} {
set text1 [htmlOpenElem LI $liattr]
} else {
set text1 [htmlOpenElem LI NOATTR]
}
if {$text1 == ""} {return}
append text $text1
if {$useTabMarks} {append text "・"}
}
}
append text "¥r[htmlCloseElem $ltype]¥r¥r"
if {$useTabMarks} {append text "・"}
if {$IsSel} { deleteSelection }
insertText $text
goto $currpos
}
# Add list entry. If there is a selection, make it the entry.
proc htmlElemListEntry {liattr} {
global htmlCurSel htmlIsSel HTMLmodeVars
set containers $HTMLmodeVars(lidtAreContainers)
set useTabMarks $HTMLmodeVars(useTabMarks)
htmlGetSel
set sel $htmlCurSel
set isSel $htmlIsSel
set text [htmlOpenCR]
set text1 [htmlOpenElem LI $liattr]
if {$text1 == ""} {return}
append text $text1
if {$isSel} { deleteSelection }
if {$containers} {
if {$isSel} {
insertText $text "${sel}" [htmlCloseElem LI]
} else {
set currpos [expr [getPos] + [string length $text]]
append text [htmlCloseElem LI]
if {$useTabMarks} { append text "・"}
insertText $text
goto $currpos
}
} else {
insertText $text $sel
}
}
# Make list items from selction.
proc htmlMakeList {} {
global HTMLmodeVars
set isContainer $HTMLmodeVars(lidtAreContainers)
if {![isSelection]} {
beep
message "No selection."
return
}
set values [dialog -w 220 -h 80 ¥
-t "Each item begins with:" 10 10 160 25 -e "*" 170 10 200 25 ¥
-b OK 20 45 85 65 -b Cancel 105 45 170 65]
if {[lindex $values 2]} {return}
set itemStr [string trim [lindex $values 0]]
if {![string length $itemStr]} {
beep
message "You must give a string which each item begins with."
return
}
set startPos [getPos]
set endPos [selEnd]
if {[catch {search -s -f 1 -i 0 -r 0 -m 0 $itemStr $startPos} res] || ¥
[lindex $res 1] > $endPos} {
beep
message "No list item in selection."
return
}
# Check that the selections begins with a list item.
set preText [getText $startPos [lindex $res 0]]
regexp {[ ¥t¥r]*} $preText test
if {$test != $preText} {
beep
message "There is some text before the first list item."
return
}
# Get each list item.
set startPos [lindex $res 1]
while {![catch {search -s -f 1 -i 0 -r 0 -m 0 $itemStr $startPos} res2] && ¥
[lindex $res2 1] <= $endPos} {
set text2 [string trimleft [string trimright [getText $startPos [lindex $res2 0]] "¥r"]]
append text "¥r<[htmlSetCase LI]>$text2"
if {$isContainer} {append text [htmlCloseElem LI]}
set startPos [lindex $res2 1]
}
set text2 [string trimleft [string trimright [getText $startPos $endPos] "¥r"]]
append text "¥r<[htmlSetCase LI]>$text2"
if {$isContainer} {append text [htmlCloseElem LI]}
append text "¥r"
replaceText [getPos] [selEnd] [string trimleft $text "¥r"]
}
# Discursive Lists (term and description elems)
#
# The selection becomes the *description* (*not* the term)
# Build a discursive list
proc htmlBuildDiscList {} {
global htmlCurSel
global htmlIsSel
global HTMLmodeVars
set containers $HTMLmodeVars(lidtAreContainers)
set useTabMarks $HTMLmodeVars(useTabMarks)
set listStr [htmlListQuestions DL DT "DT and DD"]
if {![llength $listStr]} {
return
} else {
set dlEntries [lindex $listStr 0]
set askForLiAttr [lindex $listStr 1]
}
if {$askForLiAttr} {
set liattr ""
} else {
set liattr NOATTR
}
htmlGetSel
set Sel $htmlCurSel
set text [htmlOpenCR 1]
if {$containers} {
set text1 "[htmlOpenElem DL]¥r"
if {$text1 == "¥r"} {return}
append text $text1
# the first entry
set text1 [htmlOpenElem DT $liattr]
if {$text1 == ""} {return}
append text $text1
set currpos [expr [getPos] + [string length $text]]
append text "[htmlCloseElem DT]¥t"
set text1 [htmlOpenElem DD $liattr]
if {$text1 == ""} {return}
append text $text1
if {$htmlIsSel} {
append text $Sel
} elseif {$useTabMarks} {
append text "・"
}
append text [htmlCloseElem DD]
# the rest of the entries
for {set i 1} {$i < $dlEntries} {incr i} {
append text "¥r"
set text1 [htmlOpenElem DT $liattr]
if {$text1 == ""} {return}
append text $text1
if {$useTabMarks} { append text "・" }
append text [htmlCloseElem DT]
append text "¥t"
set text1 [htmlOpenElem DD $liattr]
if {$text1 == ""} {return}
append text $text1
if {$useTabMarks} { append text "・" }
append text [htmlCloseElem DD]
}
if {$useTabMarks} {append text "・"}
} else {
set text1 [htmlOpenElem DL]
if {$text1 == ""} {return}
append text $text1
append text "¥r"
# The first entry
set text1 [htmlOpenElem DT $liattr]
if {$text1 == ""} {return}
append text $text1
set currpos [expr [getPos] + [string length $text]]
append text "¥t"
set text1 [htmlOpenElem DD $liattr]
if {$text1 == ""} {return}
append text $text1
if {$htmlIsSel} {
append text $Sel
}
if {$useTabMarks} {append text "・"}
# Now for the rest of the entries
for {set i 1} {$i < $dlEntries} {incr i} {
append text "¥r"
set text1 [htmlOpenElem DT $liattr]
if {$text1 == ""} {return}
append text $text1
if {$useTabMarks} {append text "・"}
append text "¥t"
set text1 [htmlOpenElem DD $liattr]
if {$text1 == ""} {return}
append text $text1
if {$useTabMarks} {append text "・"}
}
}
append text "¥r[htmlCloseElem DL]¥r¥r"
if {$useTabMarks} {append text "・"}
if {$htmlIsSel} { deleteSelection }
insertText $text
goto $currpos
}
# Add an individual entry to a discursive list
proc htmlElemDiscEntry {} {
global htmlCurSel htmlIsSel
global HTMLmodeVars
set useTabMarks $HTMLmodeVars(useTabMarks)
set containers $HTMLmodeVars(lidtAreContainers)
htmlGetSel
set Sel $htmlCurSel
set text [htmlOpenCR]
if {$containers} {
set text1 [htmlOpenElem DT]
if {$text1 == ""} {return}
append text $text1
set currpos [expr [getPos] + [string length $text]]
append text "[htmlCloseElem DT]¥t"
set text1 [htmlOpenElem DD]
if {$text1 == ""} {return}
append text $text1
if {$htmlIsSel} {
append text ${Sel}
} elseif {$useTabMarks} {append text "・"}
append text [htmlCloseElem DD]
if {$useTabMarks} {append text "・"}
if {$htmlIsSel} { deleteSelection }
insertText $text [htmlCloseCR]
} else {
set text1 [htmlOpenElem DT]
if {$text1 == ""} {return}
append text $text1
set currpos [expr [getPos] + [string length $text]]
append text "¥t"
set text1 [htmlOpenElem DD]
if {$text1 == ""} {return}
append text $text1
if {$htmlIsSel} {
append text $Sel
}
if {$useTabMarks} {append text "・"}
if {$htmlIsSel} { deleteSelection }
insertText $text [htmlCloseCR]
}
goto $currpos
}
# Different Input fields
proc htmlBuildInputElem {inputelem {cr1 0} {cr2 1}} {
htmlBuildOpening "INPUT TYPE=¥"${inputelem}¥"" $cr1 $cr2 $inputelem
}
# Table template. If there is any selection it is put in the first cell.
proc htmlTableTemplate {} {
global htmlCurSel htmlIsSel HTMLmodeVars
set useTabMarks $HTMLmodeVars(useTabMarks)
set values {"" "" 0 0 0 0 "No value" "No value"}
set rows ""
set cols ""
set trAttrs [htmlGetChoices TR]
foreach w $trAttrs {
if {[string match "VALIGN=*" $w]} {
lappend valignMenu [string range $w 7 end]
}
}
foreach w $trAttrs {
if {[string match "ALIGN=*" $w]} {
lappend alignMenu [string range $w 6 end]
}
}
while {![htmlIsPositiveInteger $rows] || ![htmlIsPositiveInteger $cols]} {
set box "-t {Table template} 50 10 200 25 ¥
-p 50 26 150 27 ¥
-t {Number of rows} 10 40 150 55 -e [list [lindex $values 0]] 160 40 180 55 ¥
-t {Number of columns} 10 65 150 80 -e [list [lindex $values 1]] 160 65 180 80 ¥
-c {Table headers in first row} [lindex $values 2] 10 90 250 105 ¥
-c {Table headers in first column} [lindex $values 3] 10 110 250 135 ¥
-t {Alignment for every row} 10 150 200 165 ¥
-b OK 20 230 85 250 -b Cancel 105 230 170 250"
lappend box -t VALIGN= 10 175 70 190 ¥
-m [concat [list [lindex $values 6] "No value"] $valignMenu] 80 175 175 190 ¥
-t ALIGN= 10 200 60 215 ¥
-m [concat [list [lindex $values 7] "No value"] $alignMenu] 80 200 175 215
set values [eval [concat dialog -w 230 -h 260 $box]]
# Cancel?
if {[lindex $values 5] } {return}
set rows [lindex $values 0]
set cols [lindex $values 1]
set THrow [lindex $values 2]
set THcol [lindex $values 3]
set valign [lindex $values 6]
set align [lindex $values 7]
set trOpen "<[htmlSetCase TR]"
if {$valign != "No value"} {
append trOpen " " [htmlSetCase VALIGN=[htmlAddQuotes $valign]]
}
if {$align != "No value"} {
append trOpen " " [htmlSetCase ALIGN=[htmlAddQuotes $align]]
}
append trOpen ">"
if {![htmlIsPositiveInteger $rows] || ![htmlIsPositiveInteger $cols] } {
alertnote "The number of rows and columns must be specified."
}
}
set tableOpen [htmlOpenElem TABLE]
if {![string length $tableOpen]} {return}
htmlGetSel
if {$htmlIsSel} {deleteSelection}
set text [htmlOpenCR 1]
append text "¥r" $tableOpen "¥r"
for {set i 1} {$i <= $rows} {incr i} {
append text "¥r$trOpen¥r"
for {set j 1} {$j <= $cols} {incr j} {
# Put TH in first row or column?
if {$i == 1 && $THrow || $j == 1 && $THcol} {
set cell [htmlSetCase TH]
} else {
set cell [htmlSetCase TD]
}
append text "<$cell>"
if {$i == 1 && $j == 1} {
if {$htmlIsSel} {
append text $htmlCurSel
} else {
set curPos [expr [getPos] + [string length $text]]
}
} elseif {$htmlIsSel && ( $i == 1 && $j == 2 || $i == 2 && $cols == 1 )} {
set curPos [expr [getPos] + [string length $text]]
} elseif {$useTabMarks} {
append text "・"
}
append text [htmlCloseElem $cell]
}
append text "¥r[htmlCloseElem TR]¥r"
}
append text "¥r[htmlCloseElem TABLE]¥r¥r"
if {$useTabMarks && ($rows > 1 || $cols > 1 || !$htmlIsSel)} {append text "・"}
insertText $text
goto $curPos
}
# Take table rows in a selection and remove the TR, TD and TH elements and
# put tabs between the elements.
proc htmlrowsToTabs {} {
if {![isSelection]} {
beep
message "No selection."
return
}
set startPos [getPos]
set endPos [selEnd]
if {[catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ ¥t¥r]+[^>]*>|>)} $startPos} res] || ¥
[lindex $res 1] > $endPos} {
beep
message "No table row in selection."
return
}
# Check that the selections begins with a table row.
set preText [getText $startPos [lindex $res 0]]
regexp {[ ¥t¥r]*} $preText test
if {$test != $preText} {
beep
message "First part of selection is not in a table row."
return
}
# Extract each table row.
set startPos [lindex $res 1]
while {![catch {search -s -f 1 -i 1 -r 1 -m 0 {<TR([ ¥t¥r]+[^>]*>|>)} $startPos} res2] && ¥
[lindex $res2 1] <= $endPos} {
set text2 [getText $startPos [lindex $res2 0]]
regsub -all "¥[¥t¥r¥]+" $text2 " " text2
append text [string trim $text2] "¥r"
set startPos [lindex $res2 1]
}
set text2 [getText $startPos $endPos]
regsub -all "¥[¥t¥r¥]+" $text2 " " text2
append text [string trim $text2]
# Check that there is nothing after the last table row.
if {![catch {search -s -f 1 -i 1 -r 1 -m 0 {</TR>} $startPos} res] ¥
&& [lindex $res 1] <= $endPos} {
set preText [getText [lindex $res 1] $endPos]
regexp {[ ¥t¥r]*} $preText test
if {$test != $preText} {
beep
message "Last part of selection not in a table row."
return
}
}
# Make the transformation.
foreach ln [split $text "¥r"] {
if {![string length $ln]} continue
regsub -all {> +<} $ln "><" ln
regsub -all {<(t|T)(h|H|d|D)([ ]+[^>]*>|>)} $ln "¥t" ln
regsub { } $ln "" ln
regsub -all {</(t|T)(h|H|d|D|r|R)>} $ln "" ln
append out "$ln¥r"
}
replaceText [getPos] [selEnd] $out
}
# Convert tab-delimited format to table rows.
# First row and first coloumn can optionally consist of table headers.
proc htmltabsToRows {} {
global HTMLmodeVars
if {![isSelection]} {
beep
message "No selection."
return
}
append oelem "¥r" [htmlOpenElem TR] "¥r"
if {$oelem == "¥r¥r"} {return}
if {!$HTMLmodeVars(useBigWindows)} {
if {$HTMLmodeVars(promptNoisily)} {beep}
while {[catch {statusPrompt "Table headers in first row? ¥[n¥] " ¥
htmlStatusAskYesOrNo} v]} {
if {$v == "Cancel all!"} {message "Cancel"; return}
}
if {$v == "yes"} {
set THrow 1
} else {
set THrow 0
}
if {$HTMLmodeVars(promptNoisily)} {beep}
while {[catch {statusPrompt "Table headers in first column? ¥[n¥] " ¥
htmlStatusAskYesOrNo} v]} {
if {$v == "Cancel all!"} {message "Cancel"; return}
}
if {$v == "yes"} {
set THcol 1
} else {
set THcol 0
}
} else {
set THbox [dialog -w 230 -h 105 -t "Put table headers in" 10 10 240 30 ¥
-c "first row" 0 10 40 100 60 -c "first column" 0 110 40 220 60 ¥
-b OK 20 75 85 95 -b Cancel 105 75 170 95]
if {[lindex $THbox 3]} {return}
set THrow [lindex $THbox 0]
set THcol [lindex $THbox 1]
}
set out [htmlOpenCR]
set i 1
foreach ln [split [string trimright [getSelect] "¥r"] "¥r"] {
if {![string length $ln]} {
append out "$oelem[htmlCloseElem TR]¥r"
} else {
# Should there be headers in the first row?
if {$i == 1 && $THrow} {
set cell TH
} else {
set cell TD
}
# Should there be headers in the first column?
if {$THcol || ($i == 1 && $THrow)} {
set fcell TH
} else {
set fcell TD
}
regsub -all { } $ln [htmlSetCase "</$cell><$cell>"] ln
if {$THcol} {
regsub {[tT][dDhH]} $ln [htmlSetCase TH] ln
}
append out "$oelem<[htmlSetCase $fcell]>$ln"
# Add cell or fcell closing, depending on if there is more than one cell.
if {![regexp [htmlCloseElem $fcell] $ln]} {
append out [htmlCloseElem $fcell]
} else {
append out [htmlCloseElem $cell]
}
append out "¥r[htmlCloseElem TR]¥r"
incr i
}
}
replaceText [getPos] [selEnd] $out
}
proc htmlElemComment {} {
global htmlCurSel
global htmlIsSel
global HTMLmodeVars
set useTabMarks $HTMLmodeVars(useTabMarks)
set commentPreString $HTMLmodeVars(prefixString)
set commentSufString $HTMLmodeVars(suffixString)
htmlGetSel
if {$htmlIsSel} { deleteSelection }
set text "[htmlOpenCR]${commentPreString}$htmlCurSel"
set currpos [expr [getPos] + [string length $text]]
append text $commentSufString [htmlCloseCR]
if {!$htmlIsSel && $useTabMarks} {append text "・"}
insertText $text
if {!$htmlIsSel} {
goto $currpos
}
}
#
# Template for new file: HTML, TITLE, HEAD, BODY or FRAMESET
# Optionally input BASE, LINK, ISINDEX, META and SCRIPT in HEAD.
# We do not put in a DOCTYPE line.
proc htmlNewTemplate {doctype} {
global htmlCurSel htmlIsSel HTMLmodeVars htmlHeadElements1 htmlHeadElements3 htmlPackageToUse
set useTabMarks $HTMLmodeVars(useTabMarks)
set footers $HTMLmodeVars(footers)
set headelems [set htmlHeadElements$htmlPackageToUse]
set bodyText ""
# If the window is not empty, either delete text or put it in the body.
if {![htmlIsEmptyFile]} {
set delBox [dialog -w 320 -h 90 -t "Nonempty window. Do you want to put the text¥
in the document's BODY, or delete it?" 10 10 310 50 ¥
-b "Put in BODY" 20 60 120 80 -b Delete 140 60 205 80 -b Cancel 225 60 290 80]
if {[lindex $delBox 1]} {
deleteText 0 [maxPos]
} elseif {[lindex $delBox 2]} {
return
} else {
set bodyText "[getText 0 [maxPos]]¥r"
}
}
if {$doctype == "FRAMESET"} {
set htxt "New document with frames"
} else {
set htxt "New document"
}
# Building footer menu.
foreach f $footers {
lappend foot [file tail $f]
}
set footmenu {"No footer"}
if {[info exists foot]} {
set footmenu [concat $footmenu $foot]
}
set docTitle ""
set inHead {0 0 ""}
foreach elem $headelems {
lappend inHead 0
}
lappend inHead "No footer"
while {![string length $docTitle]} {
# Construct the dialog box.
set box "-t [list $htxt] 100 10 300 25 -p 100 30 250 31 -t {TITLE} 10 40 60 55 ¥
-e [list [lindex $inHead 2]] 70 40 390 55 ¥
-t {Select the elements you want in the document¥'s HEAD} 10 70 390 85"
set hpos 100
set i 3
foreach elem $headelems {
append box " -c $elem [lindex $inHead $i] 10 $hpos 150 [expr $hpos + 15]"
incr hpos 20
incr i
}
incr hpos 10
append box " -t Footer 10 $hpos 80 [expr $hpos + 15] ¥
-m [list [concat [list [lindex $inHead $i]] $footmenu]] 90 $hpos 250 [expr $hpos + 15]"
incr hpos 30
set inHead [eval [concat dialog -w 400 -h [expr $hpos + 30] ¥
-b OK 20 $hpos 85 [expr $hpos + 20] ¥
-b Cancel 110 $hpos 175 [expr $hpos + 20] $box]]
if {[lindex $inHead 1] } {return}
set docTitle [string trim [lindex $inHead 2]]
if {![string length $docTitle]} {
alertnote "A document title is required."
}
}
set text [htmlOpenElem HTML]
if {$text == ""} {return}
set text1 [htmlOpenElem HEAD]
if {$text1 == ""} {return}
append text "¥r¥r${text1}¥r¥r"
append text "[htmlOpenElem TITLE]${docTitle}[htmlCloseElem TITLE]¥r"
set hasScript 0
for {set i 0} {$i < [llength $headelems]} {incr i} {
if {[lindex $inHead [expr $i + 3]]} {
set text1 [htmlOpenElem [lindex $headelems $i]]
if {$text1 != ""} {
append text "¥r${text1}"
if {[lindex $headelems $i] == "SCRIPT"} {
append text "¥r"
set currpos [string length $text]
set hasScript 1
append text "¥r[htmlCloseElem SCRIPT]"
}
}
}
}
append text "¥r¥r[htmlCloseElem HEAD]¥r¥r"
set text1 [htmlOpenElem $doctype]
if {$text1 == ""} {return}
append text "$text1¥r¥r"
append text $bodyText
if {!$hasScript} {
set currpos [string length $text]
} elseif {$useTabMarks} {
append text "・"
}
# Insert footer.
set footval [lindex $inHead [expr [llength $headelems] + 3]]
if {$footval != "No footer"} {
set footerFile [lindex $footers [lsearch -exact $foot $footval]]
if {![catch {readFile $footerFile} footText]} {
append text "¥r¥r$footText"
} else {
alertnote "Could not read footer, $footerFile"
}
}
append text "¥r¥r[htmlCloseElem $doctype]¥r¥r[htmlCloseElem HTML]"
if {![htmlIsEmptyFile]} {deleteText 0 [maxPos]}
insertText $text
goto $currpos
}